home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Goodies / NEWINT~1 / OWNERD~1 / FRMSTA~1.FRM (.txt) < prev    next >
Visual Basic Form  |  1997-06-05  |  5KB  |  150 lines
  1. VERSION 5.00
  2. Begin VB.Form frmStatusBar 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "VB API created Status Bar with Progress Bar"
  5.    ClientHeight    =   2070
  6.    ClientLeft      =   3435
  7.    ClientTop       =   4290
  8.    ClientWidth     =   8100
  9.    LinkTopic       =   "Form3"
  10.    MaxButton       =   0   'False
  11.    NegotiateMenus  =   0   'False
  12.    ScaleHeight     =   2070
  13.    ScaleWidth      =   8100
  14.    Tag             =   "0"
  15.    Begin VB.CommandButton TabStp 
  16.       Height          =   405
  17.       Left            =   -870
  18.       TabIndex        =   0
  19.       Top             =   2700
  20.       Width           =   810
  21.    End
  22.    Begin VB.CommandButton Command1 
  23.       Caption         =   "Create Progress Bar in Pane 4"
  24.       Height          =   360
  25.       Left            =   225
  26.       TabIndex        =   2
  27.       Top             =   1155
  28.       Width           =   2415
  29.    End
  30.    Begin VB.Timer Timer1 
  31.       Interval        =   1000
  32.       Left            =   7890
  33.       Top             =   90
  34.    End
  35.    Begin VB.Label Label1 
  36.       BackStyle       =   0  'Transparent
  37.       Caption         =   $"frmStatusBar.frx":0000
  38.       BeginProperty Font 
  39.          Name            =   "MS Sans Serif"
  40.          Size            =   9.75
  41.          Charset         =   0
  42.          Weight          =   700
  43.          Underline       =   0   'False
  44.          Italic          =   0   'False
  45.          Strikethrough   =   0   'False
  46.       EndProperty
  47.       Height          =   930
  48.       Left            =   180
  49.       TabIndex        =   1
  50.       Top             =   315
  51.       Width           =   7620
  52.       WordWrap        =   -1  'True
  53.    End
  54. Attribute VB_Name = "frmStatusBar"
  55. Attribute VB_GlobalNameSpace = False
  56. Attribute VB_Creatable = False
  57. Attribute VB_PredeclaredId = True
  58. Attribute VB_Exposed = False
  59. Private zStatBar As New CStatusBar32x
  60. Private Const WM_DRAWITEM = &H2B
  61. Private ProgBarActive As Boolean
  62. Private Type PaneInfo
  63. Panes(4) As String
  64. PaneAlignment(4) As sbAlignment
  65. TextColor(4) As SystemColorConstants
  66. textoffset(4) As Integer
  67. End Type
  68. Public Sub UpDateStat()
  69. zStatBar.DrawTextPic 0, Format(Time, "hh:mm:ss AMPM"), 0, CENTER, vbBlue, , 14
  70. zStatBar.DrawTextPic 1, "Pane - 1", 22, CENTER, , True
  71. zStatBar.DrawTextPic 2, "Pane - 2", 10, Left, vbRed, True, 22
  72. zStatBar.DrawTextPic 3, "Pane - 3", 20, Left, vbBlue, , 22
  73. zStatBar.DrawTextPic 4, Format(Date, "DD-MMMM-YY"), 30, CENTER, , True
  74. End Sub
  75. Private Sub Command1_Click()
  76. Dim zProgBar As New CProgBar32
  77. Dim PaneRect As RECT
  78. 'Get Pane 4s dimensions
  79. Call SendMessage(zStatBar.GetStatBarHwnd, SB_GETRECT, 4, PaneRect)
  80. With zProgBar
  81.  'Set hwnd as a parent instead of an object
  82.  .SethWndParent = zStatBar.GetStatBarHwnd
  83.  'Create Progress Bar in the 4 Pane of StatusBar (0 based)
  84.  .Create PaneRect.Left, PaneRect.Top, PaneRect.Right - PaneRect.Left + 15, PaneRect.Bottom - PaneRect.Top
  85. End With
  86. Dim zStepProgBar As Integer
  87. 'Step Progress Bar
  88. For zStepProgBar = 0 To 100 Step 2
  89. zProgBar.SetProgBarPos zStepProgBar
  90. 'Put as slight Delay in there
  91. zProgBar.DelayProgBar 2
  92. 'Destroy Progress Bar
  93. zProgBar.DestroyProgBar
  94. 'Make sure Pane 4 is drawn when we are done
  95. UpDateStat
  96. End Sub
  97. Private Sub Form_Load()
  98. 'Written by Ramon Guerrero for
  99. 'Hardcore Visual Basic 5.0
  100. 'ZoneCorp@dallas.net
  101. 'ZoneCorp@Aol.com
  102. 'ZoneCOrp@Compuserve.com
  103. With zStatBar
  104.   Set .Parent = Me
  105.       .Create
  106. End With
  107. 'Get the Icons for the Status bar
  108. zStatBar.SetIcon 0, 0
  109. zStatBar.SetIcon 1, 1
  110. zStatBar.SetIcon 2, 2
  111. zStatBar.SetIcon 3, 3
  112. zStatBar.SetIcon 4, 4
  113. 'SubClass Form
  114.  SubClass Me.hwnd
  115. End Sub
  116. Private Sub UnSubClass()
  117.  Dim hWndCur As Long
  118.     hWndCur = Me.hwnd
  119.     If NextProcs Then
  120.         SetWindowLong hWndCur, GWL_WNDPROC, NextProcs
  121.         NextProcs = 0
  122.     End If
  123. End Sub
  124.  Private Sub SubClass(hwnd As Long)
  125. On Error Resume Next
  126. NextProcs = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
  127. End Sub
  128. Public Sub Form_Resize()
  129.  zStatBar.Resize
  130. End Sub
  131. Public Sub ProcMsg(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, result As Long)
  132.      
  133. On Error Resume Next
  134. Select Case uMsg
  135.  'we need to catch this message so we can update the status bar
  136.  Case WM_DRAWITEM
  137.  'Don't pass it on
  138.  Nodef = False
  139.  'Redraw text and icons
  140.  UpDateStat
  141. End Select
  142. End Sub
  143. Private Sub Form_Unload(Cancel As Integer)
  144. UnSubClass
  145. zStatBar.DestroyStatBar
  146. End Sub
  147. Private Sub Timer1_Timer()
  148. zStatBar.DrawTextPic 0, Format(Time, "hh:mm:ss AMPM"), 0, CENTER, vbBlue, , 14
  149. End Sub
  150.